module Code where

import AbsC
import qualified Data.Map as Map
import Data.Char
import Data.List
import PrintC

initCode :: Code
initCode = Map.empty
   
initPC :: PC
initPC = 0

initLabel :: Int
initLabel = 0

initTemp :: Int
initTemp = 0

constAddr :: Const -> Address
constAddr c = Constant c

varAddr :: Id -> Address
varAddr i = Var i

tempAddr :: Int -> (Address,Int)
tempAddr i = (Temp i, i+1)

intLabel i = (L i, i+1)
funLabel fi = F fi
nullLabel = N

compDecl (DVar _ _ _ _) (DFun _ _ _ _) = LT
compDecl (DVar _ _ _ _) (DVar _ _ _ _) = EQ
compDecl (DFun _ _ _ _) (DVar _ _ _ _) = GT
compDecl (DFun _ _ _ _) (DFun _ _ _ _) = EQ

aErr [] xs = xs
aErr x xs = x:xs

addError (TErr s) xs = aErr s xs
addError (Array _ t) xs = addError t xs
addError (PType t) xs = addError t xs
addError _ xs = xs

merge = (++)

changeLabel (IfRel r a1 a2 _) lab = (IfRel r a1 a2 lab)
changeLabel (If a1 _) lab = (If a1 lab)
changeLabel (Goto _) lab = (Goto lab)

checkFirstStmt code pc ml@(Just (F _)) = genNoOp code pc ml
checkFirstStmt c p m = (c,p,m)

newLabel lab Nothing = (l,(Just ml))
   where
      (ml,l) = intLabel lab
newLabel l ml = (l,ml)

backPatch [] code l ml = (code,l,ml)
backPatch xs code l ml = backP xs code l ml 
backP xs code l Nothing = (c,l',(Just lab))
   where
      (lab,l') = intLabel l
      c = foldr (bp lab) code xs
      bp lb pc cd = c'
         where
            (Just (ml,inst)) = Map.lookup pc cd
            inst' = changeLabel inst lb
            (c',_,_) = insertCode pc (ml,inst') cd

backP xs code l lab@(Just lb) = (c,l,lab)
   where
      c = foldr (bp lb) code xs
      bp lb pc cd = c'
         where
            (Just (ml,inst)) = Map.lookup pc cd
            inst' = changeLabel inst lb
            (c',_,_) = insertCode pc (ml,inst') cd

insertCode pc (mlab,inst) code = (c,p,Nothing)
   where
      c = Map.insert pc (mlab,inst) code
      p = pc + 1

genGotoMain code pc l [] = (c',p',l)
   where
      (c',p',_) = genGotoLabel code pc Nothing (Just fun)
      fun = funLabel (Fun (Id "main") 0)

genGotoMain code pc l xs = (c',pc,l')
   where
      (c',l',_) = backPatch xs code l (Just fun)
      fun = funLabel (Fun (Id "main") 0)

genNoOp code pc mlab = insertCode pc (mlab,noop) code
   where
      noop = NoOp

genGotoLabel code pc mlab (Just lab) = (c,p,m)
   where
      goto = Goto lab
      (c,p,m) = insertCode pc (mlab,goto) code

genGotoLabel c p m _ = (c,p,m)

genGotoN code pc mlab backList = (c,p,m,bl)
   where
      goto = Goto nullLabel
      (c,p,m) = insertCode pc (mlab,goto) code
      bl = pc : backList

genIfRel code pc l mlab truelist falselist rOp (Just adr1) (Just adr2) = (c',p',l,m',tl,fl)
   where
      (c,p,m) = insertCode pc (mlab,inst) code
      inst = IfRel rOp adr1 adr2 nullLabel
      (c',p',m',fl) = genGotoN c p m falselist
      tl = pc : truelist
      
genIfRel code pc l mlab truelist falselist _ _ _ = (code,pc,l,mlab,truelist,falselist)

genIf code pc l mlab truelist falselist (Just adr1) = (c',p',l,m',tl,fl)
   where
      (c,p,m) = insertCode pc (mlab,inst) code
      inst = If adr1 nullLabel
      (c',p',m',fl) = genGotoN c p m falselist
      tl = pc : truelist
      
genIf code pc l mlab truelist falselist _ = (code,pc,l,mlab,truelist,falselist)

genRetVoid code pc mlab = (c,p,m)
   where
      (c,p,m) = insertCode pc (mlab,RetVoid) code

genRetAddr code pc mlab (Just addr) = (c,p,m)
   where
      (c,p,m) = insertCode pc (mlab,ret) code
      ret = Ret addr

genRetAddr c p m _ = (c,p,m)

genAssBin c p t m op adr1 adr2 Nothing = genAssBin c p t' m op adr1 adr2 (Just temp)
   where
      (temp, t') = tempAddr t

genAssBin c p t m op (Just adr1) (Just adr2) (Just adr) = (c',p',t,m',(Just adr))
   where
      (c',p',m') = insertCode p (m,inst adr) c
      inst ad = AssBin op ad adr1 adr2

genAssUn c p t m op adr1 Nothing = genAssUn c p t' m op adr1 (Just temp)
   where
      (temp,t') = tempAddr t

genAssUn c p t m op (Just adr1) (Just adr) = (c',p',t,m',(Just adr))
   where
      (c',p',m') = insertCode p (m,inst adr) c
      inst ad = AssUn op ad adr1

genCopy c p t m adr1 Nothing = genCopy c p t' m adr1 (Just temp)
   where
      (temp,t') = tempAddr t

genCopy c p t m (Just adr1) (Just adr) = (c',p',t,m',(Just adr))
   where
      (c',p',m') = insertCode p (m,inst adr) c
      inst ad = Copy ad adr1

genCast c p t m typ adr1 Nothing = genCast c p t' m typ adr1 (Just temp)
   where
      (temp,t') = tempAddr t

genCast c p t m typ (Just adr1) (Just adr) = (c',p',t,m',(Just adr))
   where
      (c',p',m') = insertCode p (m,inst adr) c
      inst ad = Cast typ adr1 ad

genParS = foldr f
   where
      f adr (c,p,l,t,m) = genPar c p l t m adr

genPar c p l t m (Just adr) = (c',p',l,t,m')
   where
      (c',p',m') = insertCode p (m,inst) c
      inst = Par adr

genCall c p l t m fi Nothing = genCall c p l t' m fi (Just temp)
   where
      (temp,t') = tempAddr t

genCall c p l t m fi (Just adr) = (c',p',l,t,m',(Just adr))
   where
      (c',p',m') = insertCode p (m,inst adr) c
      inst ad = Call ad $ funLabel fi

genAssDeref c p l t m adr1 Nothing = genAssDeref c p l t' m adr1 (Just temp)
   where
      (temp,t') = tempAddr t

genAssDeref c p l t m (Just adr1) (Just adr) = (c',p',l,t,m',(Just adr))
   where
      (c',p',m') = insertCode p (m,inst) c
      inst = AssDeref adr adr1

genAEl c p l t m lv rv Nothing = genAEl c p l t' m lv rv (Just temp)
   where
      (temp,t') = tempAddr t
   
genAEl c p l t m (Just lv) (Just rv) a@(Just adr) = (c',p',l,t,m',a)
   where
      (c',p',m') = insertCode p (m,inst adr) c
      inst ad = AEl ad lv rv
      
genAssAEl c p t m (Just addr) (Just caddr) (Just adr) = (c',p',t,m')
   where
      (c',p',m') = insertCode p (m,inst) c
      inst = AssAEl addr caddr adr
      
genAssAEl c p t m Nothing caddr adr = genAssAEl c p t' m (Just temp) caddr adr
   where
      (temp,t') = tempAddr t

genAssRef c p t m (Just adr) a@(Just ad) = (c',p',t,m',a)
   where
      (c',p',m') = insertCode p (m,inst) c
      inst = AssRef ad adr

genAssRef c p t m adr Nothing = genAssRef c p t' m adr (Just temp)
   where
      (temp,t') = tempAddr t
      
genAssVtoP c p t m adr Nothing = genAssVtoP c p t' m adr (Just temp)
   where
      (temp,t') = tempAddr t

genAssVtoP c p t m (Just adr) a@(Just ad) = (c',p',t,m',a)
   where
      (c',p',m') = insertCode p (m,inst) c
      inst = AssVtoP ad adr
      
genInitArrayCode c p t m ads Nothing = genInitArrayCode c p t' m ads (Just temp)
   where
      (temp,t') = tempAddr t
           
genInitArrayCode c p t m ads addr = (c',p',t',m',addr)
   where
      (c',p',t',m',_) = foldr f (c,p,t,m,0) ads
      f ad (cd,pd,td,md,idx) = (cr,pr,tr,mr,idx+1)
         where
           (cr,pr,tr,mr) = genAssAEl cd pd td md addr caddr ad
           caddr = Just $ constAddr (Int idx)

genPrePostIncDecr c1 p1 t1 m1 aOp le rval lval = genAssignOp c1 p1 t1 m1 aOp le const1 rval lval
   where
      const1 = Just $ constAddr (Int 1)

genAssgn c1 p1 t1 m1 (SId _ _) rval lval = genCopy c1 p1 t1 m1 rval lval

genAssgn c1 p1 t1 m1 _ rval lval = genAssVtoP c1 p1 t1 m1 rval lval

genAssignOp c1 p1 t1 m1 op (SId _ _) rval rval1 lval = genAssBin c1 p1 t1 m1 op rval1 rval lval

genAssignOp c1 p1 t1 m1 op _ rval rval1 lval = (c3,p3,t3,m3,lv2)
   where
      (c2,p2,t2,m2,lv2) = genAssBin c1 p1 t1 m1 op rval1 rval Nothing
      (c3,p3,t3,m3,lv3) = genAssVtoP c2 p2 t2 m2 lv2 lval

gCode = genProgCode ([],initCode,initPC,initLabel,initTemp)

genProgCode (es,code,pc,lab,temp) (Prog ds e)
   |null concErr = printTreeC $ Map.elems c''
   |otherwise = concErr
   where
         (c,p,ml,initList) = genGotoN code pc Nothing []
         e' = aErr e es
         (es',c',p',l',t,_,i') = genDeclSCode (e',c,p,lab,temp,ml,initList) ds'
         ds' = sortBy compDecl (reverse ds)
         (c'',p'',l'') = genGotoMain c' p' l' i'
         concErr = concat es'

genDeclSCode a = foldr (flip genDeclCode) a

genDeclCode (err,code,pc,lab,temp,mlab,initlist) (DFun typ fi ps s) = (e',c,p,l,t,mlab,initlist)
      where
         (e,c,p,l,t,m,_,_,_) = genStmtCode (err,code,pc,lab,temp,flab,[],[],[]) s
         flab = Just $ funLabel fi 
         e' = addError typ e

genDeclCode (err,code,pc,lab,temp,mlab,initlist) (DVar typ i (Just iv) _) = (e',c',p',l',t',m',[])
   where
      (c,l,ml) = backPatch initlist code lab mlab
      (e,c',p',l',t',m',addr') = genInitVarCode (err,c,pc,l,temp,ml,addr) iv
      addr = Just $ varAddr i
      e' = addError typ e
	  
genDeclCode (err,code,pc,lab,temp,mlab,initlist) (DVar typ _ Nothing _) = (e,code,pc,lab,temp,mlab,initlist)
   where
      e = addError typ err
      
genInitVarCode (err,code,pc,lab,temp,mlab,addr) (EVar typ) = (e,code,pc,lab,temp,mlab,addr)
   where
      e = addError typ err

genInitVarCode (err,code,pc,lab,temp,mlab,addr) (SIVar (re,typ)) = (e',c',p',l',t',ml',adr')
   where
      (e,c',p',l',t',ml',adr') = genRExprCode (err,code,pc,lab,temp,mlab,addr) re
      e' = addError typ e

genInitVarCode (err,code,pc,lab,temp,mlab,addr)  (CIVar is typ) = (e',c',p',l,t',m',adr)
   where
      (e,c,p,l,t,m,ads) = genInitVarSCode (err,code,pc,lab,temp,mlab,[]) (reverse is)
      e' = addError typ e
      (c',p',t',m',adr) = genInitArrayCode c p t m ads addr
      
genInitVarSCode = foldr f
   where
      f iv (err,code,pc,lab,temp,mlab,ads) = (e,c,p,l,t,m,addr : ads)
         where
            (e,c,p,l,t,m,addr) = genInitVarCode (err,code,pc,lab,temp,mlab,Nothing) iv
      
genStmtSCode a = foldr (flip genStmtCode) a

genStmtCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (Block ds ss) = genStmtSCode (e,c',p,l',t,m,break,continue,[]) (reverse ss)
      where
         (c,l,ml) = backPatch nextlist code lab mlab
         (e,c',p,l',t,m,_) = genDeclSCode (err,c,pc,l,temp,ml,[]) ds'
         ds' = sortBy compDecl (reverse ds)

genStmtCode a (Jmp j) = genJmpCode a j

genStmtCode a (Iter i) = genIterCode a i

genStmtCode a (Sel s) = genSelCode a s

genStmtCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (RExprStmt (r,typ)) = (e',c',p,l',t,ml',break,continue,[])
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (e,c',p,l',t,ml',addr) = genRExprCode (err,c,pc,l,temp,ml,Nothing) r
      e' = addError typ e

genStmtCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (Assgn Assign (le,typ1) (re,typ2)) = (e',c3,p3,l2,t3,m3,break,continue,[])
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (e1,c1,p1,l1,t1,m1,(lval,_)) = genLExprCode (err,c,pc,l,temp,ml,(Nothing,Nothing)) le
      (e2,c2,p2,l2,t2,m2,rval) = genRExprCode (e1,c1,p1,l1,t1,m1,Nothing) re
      e = addError typ2 e2
      e' = addError typ1 e
      (c3,p3,t3,m3,lv3) = genAssgn c2 p2 t2 m2 le rval lval

genStmtCode (err,code,pc,lab,t,mlab,break,continue,nextlist) (Assgn (AssgnArith aOp) (le,typ1) (re,typ2)) = (e',c3,p3,l2,t3,m3,break,continue,[])
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (temp,t') = tempAddr t
      (e1,c1,p1,l1,t1,m1,(lval,rval1)) = genLExprCode (err,c,pc,l,t',ml,(Nothing,(Just temp))) le
      (e2,c2,p2,l2,t2,m2,rval) = genRExprCode (e1,c1,p1,l1,t1,m1,Nothing) re
      e = addError typ2 e2
      e' = addError typ1 e
      (c3,p3,t3,m3,lv3) = genAssignOp c2 p2 t2 m2 (ArithOp aOp) le rval rval1 lval

genStmtCode (err,code,pc,lab,t,mlab,break,continue,nextlist) (Assgn (AssgnBool bOp) (le,typ1) (re,typ2)) = (e',c3,p3,l2,t3,m3,break,continue,[])
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (temp,t') = tempAddr t
      (e1,c1,p1,l1,t1,m1,(lval,rval1)) = genLExprCode (err,c,pc,l,t',ml,(Nothing,(Just temp))) le
      (e2,c2,p2,l2,t2,m2,rval) = genRExprCode (e1,c1,p1,l1,t1,m1,Nothing) re
      e = addError typ2 e2
      e' = addError typ1 e
      (c3,p3,t3,m3,lv3) = genAssignOp c2 p2 t2 m2 (BoolOp bOp) le rval rval1 lval

genJmpCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (Break s) = (e,c',p',l,temp,ml',bl,continue,[])
      where
         (c,l,ml) = backPatch nextlist code lab mlab
         (c',p',ml',bl) = genGotoN c pc ml break
         e = aErr s err

genJmpCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (Continue s) = (e,c',p',l,temp,ml',break,cl,[])
      where
         (c,l,ml) = backPatch nextlist code lab mlab
         (c',p',ml',cl) = genGotoN c pc ml continue
         e = aErr s err

genJmpCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (RetExpVoid t) = (e,c',p',l,temp,ml',break,continue,[])
      where
         (c,l,ml) = backPatch nextlist code lab mlab
         (c',p',ml') = genRetVoid c pc ml
         e = addError t err

genJmpCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (RetExp (r,typ)) = (e',c'',p'',l',t',ml'',break,continue,[])
      where
         (c,l,ml) = backPatch nextlist code lab mlab
         (e,c',p',l',t',ml',addr) = genRExprCode (err,c,pc,l,temp,ml,Nothing) r
         (c'',p'',ml'') = genRetAddr c' p' ml' addr
         e' = addError typ e

genSelCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (IfNoElse (r,typ) s) = (e',cs,ps,ls,ts,ms,br,con,nlist)
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (e,c',p',l',t',ml',truelist,falselist) = genGuardCode (err,c,pc,l,temp,ml,[],[]) r
      (c'',l'',ml'') = backPatch truelist c' l' Nothing
      (e'',cs,ps,ls,ts,ms,br,con,nl) = genStmtCode (e,c'',p',l'',t',ml'',break,continue,[]) s
      nlist = merge falselist nl
      e' = addError typ e''

genSelCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (IfElse (r,typ) s1 s2) = (e',cs2,ps2,ls2,ts2,ms2,br2,con2,nlist)
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (e,c',p',l',t',ml',truelist,falselist) = genGuardCode (err,c,pc,l,temp,ml,[],[]) r
      (c'',l'',ml'') = backPatch truelist c' l' Nothing
      (es1,cs1,ps1,ls1,ts1,ms1,br1,con1,nl1) = genStmtCode (e,c'',p',l'',t',ml'',break,continue,[]) s1
      (cn,pn,mn,nl) = genGotoN cs1 ps1 ms1 nl1
      (cp,lp,mlp) = backPatch falselist cn ls1 mn
      (es2,cs2,ps2,ls2,ts2,ms2,br2,con2,nl2) = genStmtCode (es1,cp,pn,lp,ts1,mlp,br1,con1,[]) s2
      nlist = merge nl2 nl
      e' = addError typ es2

genIterCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (While (r,typ) s) = (e'',cw,pn,ls,ts,mn,break,continue,nlist)
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (ll,mll) = newLabel l ml
      (e,c',p',l',t',ml',truelist,falselist) = genGuardCode (err,c,pc,ll,temp,mll,[],[]) r
      (c'',l'',ml'') = backPatch truelist c' l' Nothing
      (e'',cs,ps,ls,ts,ms,br,con,nl) = genStmtCode (e,c'',p',l'',t',ml'',[],[],[]) s
      (cn,pn,mn,clist) = genGotoN cs ps ms nl
      conlist = merge clist con
      (cw,lw,mlw) = backPatch conlist cn ls mll
      nlist = merge falselist br
      e' = addError typ e''

genIterCode (err,code,pc,lab,temp,mlab,break,continue,nextlist) (DoWhile s (r,typ)) = (e'',c'',p',l',t',ml',break,continue,nlist)
   where
      (c,l,ml) = backPatch nextlist code lab mlab
      (ll,mll) = newLabel l ml
      (e,cs,ps,ls,ts,ms,br,con,nl) = genStmtCode (err,c,pc,ll,temp,mll,[],[],[]) s
      (cn,pn,mn,clist) = genGotoN cs ps ms nl
      conlist = merge clist con
      (ll',mll') = newLabel ls mn
      (cw,lw,mlw) = backPatch conlist cn ll' mll'
      (e',c',p',l',t',ml',truelist,falselist) = genGuardCode (e,cw,pn,lw,ts,mlw,[],[]) r
      (c'',_,_) = backPatch truelist c' ll mll
      e'' = addError typ e'
      nlist = merge falselist br

genGuardCode (err,code,pc,lab,temp,mlab,truelist,falselist) (Const (Bool True)) = (err,c,p,lab,temp,ml,tl,falselist)
   where
      (c,p,ml,tl) = genGotoN code pc mlab truelist

genGuardCode (err,code,pc,lab,temp,mlab,truelist,falselist) (Const (Bool False)) = (err,c,p,lab,temp,ml,truelist,fl)
   where
      (c,p,ml,fl) = genGotoN code pc mlab falselist

genGuardCode (err,code,pc,lab,temp,mlab,truelist,falselist) (InfixOp (RelOp rOp) (r1,typ1) (r2,typ2)) = (e',c,p,l,t2,m,tl,fl)
   where
      (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,Nothing) r1
      (e2,c2,p2,l2,t2,m2,adr2) = genRExprCode (e1,c1,p1,l1,t1,m1,Nothing) r2
      e = addError typ1 e2
      e' = addError typ2 e
      (c,p,l,m,tl,fl) = genIfRel c2 p2 l2 m2 truelist falselist rOp adr1 adr2

genGuardCode (err,code,pc,lab,temp,mlab,truelist,falselist) (InfixOp (BoolOp Or) (r1,typ1) (r2,typ2)) = (e',c2,p2,l2,t2,m2,tl2,fl2)
   where
      (e1,c1,p1,l1,t1,ml1,tl1,fl1) = genGuardCode (err,code,pc,lab,temp,mlab,truelist,[]) r1
      (cb,lb,mlb) = backPatch fl1 c1 l1 ml1
      (e2,c2,p2,l2,t2,m2,tl2,fl2) = genGuardCode (e1,cb,p1,lb,t1,mlb,tl1,falselist) r2
      e = addError typ1 e2
      e' = addError typ2 e

genGuardCode (err,code,pc,lab,temp,mlab,truelist,falselist) (InfixOp (BoolOp And) (r1,typ1) (r2,typ2)) = (e',c2,p2,l2,t2,m2,tl2,fl2)
   where
      (e1,c1,p1,l1,t1,ml1,tl1,fl1) = genGuardCode (err,code,pc,lab,temp,mlab,[],falselist) r1
      (cb,lb,mlb) = backPatch tl1 c1 l1 ml1
      (e2,c2,p2,l2,t2,m2,tl2,fl2) = genGuardCode (e1,cb,p1,lb,t1,mlb,truelist,fl1) r2
      e = addError typ1 e2
      e' = addError typ2 e

genGuardCode a@(err,code,pc,lab,temp,mlab,truelist,falselist) (UnaryOp Not (re,typ1)) = (e',c',p',l',t',ml',tl',fl')
   where
      (e,c',p',l',t',ml',tl,fl) = genGuardCode (err,code,pc,lab,temp,mlab,[],[]) re
      e' = addError typ1 e
      fl' = merge falselist tl
      tl' = merge truelist fl

genGuardCode (err,code,pc,lab,temp,mlab,truelist,falselist) re = (e1,c,p,l,t1,m,tl,fl)
   where
      (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,Nothing) re
      (c,p,l,m,tl,fl) = genIf c1 p1 l1 m1 truelist falselist adr1

genRExprCode (err,code,pc,lab,temp,mlab,adr) (InfixOp op (r1,typ1) (r2,typ2)) = (e',c',p',l2,t',m',ad')
   where
      (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,Nothing) r1
      (e2,c2,p2,l2,t2,m2,adr2) = genRExprCode (e1,c1,p1,l1,t1,m1,Nothing) r2
      e = addError typ1 e2
      e' = addError typ2 e
      (c',p',t',m',ad') = genAssBin c2 p2 t2 m2 op adr1 adr2 adr

genRExprCode (err,code,pc,lab,temp,mlab,adr) (UnaryOp op (r1,typ1)) = (e',c',p',l1,t',m',ad')
   where
      (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,Nothing) r1
      e' = addError typ1 e1
      (c',p',t',m',ad') = genAssUn c1 p1 t1 m1 op adr1 adr

genRExprCode (err,code,pc,lab,temp,mlab,Nothing) (Const c) = (err,code,pc,lab,temp,mlab,ad')
   where
      ad' = Just $ constAddr c
      
genRExprCode (err,code,pc,lab,temp,mlab,addr) (Const c) = (err,c',p',lab,t',m',adr)
   where
      ad' = Just $ constAddr c
      (c',p',t',m',adr) = genCopy code pc temp mlab ad' addr

genRExprCode (err,code,pc,lab,temp,mlab,adr) (Coertion _ typ r1) = (e1,c',p',l1,t',m',ad')
   where
      (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,Nothing) r1
      (c',p',t',m',ad') = genCast c1 p1 t1 m1 typ adr1 adr

genRExprCode (err,code,pc,lab,temp,mlab,adr) (FCall fi rs) = (e1,c3,p3,l3,t3,m3,adr3)
   where
      (e1,c1,p1,l1,t1,m1,adr1,ads) = genRExprSCode (err,code,pc,lab,temp,mlab,Nothing,[]) (reverse rs)
      (c2,p2,l2,t2,m2) = genParS (c1,p1,l1,t1,m1) ads
      (c3,p3,l3,t3,m3,adr3) = genCall c2 p2 l2 t2 m2 fi adr

genRExprCode (err,code,pc,lab,temp,mlab,adr) (LExpr (le,typ)) = (e,c1,p1,l1,t1,m1,rval)
   where
      (e1,c1,p1,l1,t1,m1,(lval,rval)) = genLExprCode (err,code,pc,lab,temp,mlab,(Nothing,adr)) le
      e = addError typ e1

genRExprCode (err,code,pc,lab,temp,mlab,adr) (Ref (le,typ)) = (e,c2,p2,l1,t2,m2,adr2)
   where
      (e1,c1,p1,l1,t1,m1,(lval,rval)) = genLExprCode (err,code,pc,lab,temp,mlab,(Nothing,Nothing)) le
      e = addError typ e1
      (c2,p2,t2,m2,adr2) = genAssRef c1 p1 t1 m1 lval adr

genRExprCode (err,code,pc,lab,t,mlab,adr) (PrePostIncDecr PostDecr (le,typ)) = (e,c2,p2,l1,t2,m2,rval)
   where
      (temp,t') = tempAddr t
      (e1,c1,p1,l1,t1,m1,(lval,rval)) = genLExprCode (err,code,pc,lab,t',mlab,(Nothing,(Just temp))) le
      e = addError typ e1
      (c2,p2,t2,m2,lv2) = genPrePostIncDecr c1 p1 t1 m1 (ArithOp Sub) le rval lval

genRExprCode (err,code,pc,lab,t,mlab,adr) (PrePostIncDecr PostInc (le,typ)) = (e,c2,p2,l1,t2,m2,rval)
   where
      (temp,t') = tempAddr t
      (e1,c1,p1,l1,t1,m1,(lval,rval)) = genLExprCode (err,code,pc,lab,t',mlab,(Nothing,(Just temp))) le
      e = addError typ e1
      (c2,p2,t2,m2,lv2) = genPrePostIncDecr c1 p1 t1 m1 (ArithOp Add) le rval lval

genRExprCode (err,code,pc,lab,t,mlab,adr) (PrePostIncDecr PreDecr (le,typ)) = (e,c2,p2,l1,t2,m2,lv2)
   where
      (temp,t') = tempAddr t
      (e1,c1,p1,l1,t1,m1,(lval,rval)) = genLExprCode (err,code,pc,lab,t',mlab,(Nothing,(Just temp))) le
      e = addError typ e1
      (c2,p2,t2,m2,lv2) = genPrePostIncDecr c1 p1 t1 m1 (ArithOp Sub) le rval lval
      
genRExprCode (err,code,pc,lab,t,mlab,adr) (PrePostIncDecr PreInc (le,typ)) = (e,c2,p2,l1,t2,m2,lv2)
   where
      (temp,t') = tempAddr t
      (e1,c1,p1,l1,t1,m1,(lval,rval)) = genLExprCode (err,code,pc,lab,t',mlab,(Nothing,(Just temp))) le
      e = addError typ e1
      (c2,p2,t2,m2,lv2) = genPrePostIncDecr c1 p1 t1 m1 (ArithOp Add) le rval lval

genRExprSCode = foldr f
   where
      f (r,typ) (err,code,pc,lab,temp,mlab,adr,ads) = (e,c1,p1,l1,t1,m1,Nothing,ads')
         where
            (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,adr) r
            e = addError typ e1
            ads' = adr1 : ads

genLExprCode (err,code,pc,lab,temp,mlab,(lval,Nothing)) (SId i er) = (err,code,pc,lab,temp,mlab,(vad,vad))
   where
      vad = Just $ varAddr i
      e = aErr er err

genLExprCode (err,code,pc,lab,temp,mlab,(lval,rval)) (SId i er) = (e,c1,p1,lab,t1,m1,(vad,adr))
   where
      vad = Just $ varAddr i
      e = aErr er err
      (c1,p1,t1,m1,adr) = genCopy code pc temp mlab vad rval

genLExprCode (err,code,pc,lab,temp,mlab,(lval,rval)) (Deref (re,typ)) = (e,c,p,l,t,m,(adr1,rv))
   where
      (e1,c1,p1,l1,t1,m1,adr1) = genRExprCode (err,code,pc,lab,temp,mlab,Nothing) re
      e = addError typ e1
      (c,p,l,t,m,rv) = genAssDeref c1 p1 l1 t1 m1 adr1 rval

genLExprCode (err,code,pc,lab,temp,mlab,(lval,rval)) (ArrayEl (le,typ1) (re,typ2)) = (e',c,p,l,t,m,(lv3,r))
   where
      (e1,c1,p1,l1,t1,m1,(lv,rv)) = genLExprCode (err,code,pc,lab,temp,mlab,(Nothing,Nothing)) le
      (e2,c2,p2,l2,t2,m2,rv2) = genRExprCode (e1,c1,p1,l1,t1,m1,Nothing) re
      e = addError typ2 e2
      e' = addError typ1 e
      (c3,p3,t3,m3,lv3) = genAssBin c2 p2 t2 m2 (ArithOp Add) rv rv2 lval
      (c,p,l,t,m,r) = genAEl c3 p3 l2 t3 m3 rv rv2 rval
